Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/disk_utl/statemch/filesrch.frm

Visual Basic Form | 1995-04-26 | 25.6 KB | 637 lines

VERSION 2.00
Begin Form frmSearch
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "File Search"
   ClientHeight    =   4116
   ClientLeft      =   1092
   ClientTop       =   1488
   ClientWidth     =   8520
   Height          =   4536
   Icon            =   FILESRCH.FRX:0000
   Left            =   1044
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4116
   ScaleWidth      =   8520
   Top             =   1116
   Width           =   8616
   Begin SSPanel pnContents
      Alignment       =   0  'Left Justify - TOP
      BevelInner      =   1  'Inset
      Caption         =   "File Contents"
      Height          =   4095
      Left            =   4260
      TabIndex        =   9
      Top             =   0
      Width           =   4215
      Begin CommandButton cmdExit
         Caption         =   "E&xit"
         Height          =   315
         Left            =   2640
         TabIndex        =   13
         Top             =   3600
         Width           =   1335
      End
      Begin TextBox enViewText
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   7.8
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   2775
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   11
         Top             =   720
         Width           =   3795
      End
      Begin CommandButton cmdEdit
         Caption         =   "&Edit"
         Enabled         =   0   'False
         Height          =   315
         Left            =   240
         TabIndex        =   12
         Top             =   3600
         Width           =   1335
      End
      Begin Label lbPathName
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "c:/nick/class/statmach/srcfiles.exe"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   7.8
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   360
         Width           =   3795
      End
   End
   Begin SSPanel pnSearch
      Alignment       =   0  'Left Justify - TOP
      BevelInner      =   1  'Inset
      Caption         =   "Search Parameters"
      Height          =   4095
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4215
      Begin SSPanel pnCurdir
         Alignment       =   0  'Left Justify - TOP
         BevelInner      =   1  'Inset
         BorderWidth     =   1
         Height          =   315
         Left            =   120
         TabIndex        =   8
         Top             =   3660
         Width           =   3975
      End
      Begin Timer tmrFSA
         Enabled         =   0   'False
         Interval        =   1
         Left            =   180
         Top             =   3060
      End
      Begin CommandButton cmdStop
         Cancel          =   -1  'True
         Caption         =   "&Stop"
         Enabled         =   0   'False
         Height          =   315
         Left            =   2640
         TabIndex        =   6
         Top             =   1140
         Width           =   1275
      End
      Begin CommandButton cmdBegin
         Caption         =   "&Begin"
         Default         =   -1  'True
         Height          =   315
         Left            =   420
         TabIndex        =   5
         Top             =   1140
         Width           =   1275
      End
      Begin TextBox enRootDir
         Height          =   315
         Left            =   2040
         TabIndex        =   4
         Text            =   "enRootDir"
         Top             =   720
         Width           =   1875
      End
      Begin ListBox lsMatched
         Height          =   1944
         Left            =   420
         TabIndex        =   7
         Top             =   1500
         Width           =   3552
      End
      Begin TextBox enPattern
         Height          =   285
         Left            =   2040
         TabIndex        =   2
         Text            =   "enPattern"
         Top             =   360
         Width           =   1875
      End
      Begin Label lbRootDir
         BackStyle       =   0  'Transparent
         Caption         =   "Starting at:"
         Height          =   195
         Left            =   780
         TabIndex        =   3
         Top             =   720
         Width           =   1140
      End
      Begin Label lbPattern
         BackStyle       =   0  'Transparent
         Caption         =   "File Pattern:"
         Height          =   195
         Left            =   720
         TabIndex        =   1
         Top             =   420
         Width           =   1350
      End
   End
Option Explicit
DefInt A-Z
' ----------------------------------------------------------------
' State Machine Example: File Search Utility
' Created by A. Nicklas Malik
' License:  You may use this utility, and any and all accompanying code
'     in the creation of any software product, for resale or otherwise,
'     as you see fit.  You may distribute this program and its accompanying
'     source code on any media, under one condition: you may not charge any
'     amount of money exceeding the duplication costs.  This code
'     is free to be used on an AS IS basis.  Testing for program errors is
'     your responsibility.  There is NO WARRANTY on this code WHATSOEVER.
' ----------------------------------------------------------------
'  PURPOSE
' This program implements an event-driven Finite State Automaton.  The issue
' has been extensively explored in recent articles by Daniel Appleman.  The
' author of this code agrees with Mr. Appleman that state machines, as these
' programs are called, can be an extremely useful technique when attempting to
' handle long, involved calculations or manipulations in event-driven systems
' like Windows.
' The purpose of this program is to educate and enlighten.  If you get a useful
' utility in the bargain, then consider yourself lucky.
' ----------------------------------------------------------------
'  FUNCTIONAL DESCRIPTION
'  File Search utility: given a pattern to match against, this utility will scan
'  the user's hard drive looking for files that match the pattern.  The matching
'  will begin in the directory specified and will proceed to include all
'  subdirectories under the specified directory.
'  At any time during the search, the user can:
'     1) restart the search with a new criteria
'     2) exit the app
'     3) select one of the files found so far
'     4) abort the search without losing any information
'  Note: if the user selects a file (action #3), the first page or so of text will
'  be displayed in the text box (unless the file is binary).  The user can click the
'  edit button to bring the current file into the Notepad editor.
'  None of this functionality is earth-shattering.  The unique thing is that all
'  of these actions can take place before the search is completed.
' ----------------------------------------------------------------
'  INNER WORKINGS
'  To date, there is no accompanying article to explain the workings of this
'  program.  Unfortunately, this topic appears too arcane, and technical, for
'  the average magazine reader.  Instead, I will attempt to explain, in the
'  next few paragraphs, where you can look in this code for clues to its
'  operation.  I hope that this information is enough to get you started in
'  exploring this useful technique.
'  Normally, when a VB program begins an long operation, it "freezes" up, refusing
'  to even repaint it's windows.  On Windows 3.1 or WFWG 3.11, this actually can
'  prevent other apps from running as well, since these systems require cooperation
'  to do their multitasking, and VB apps have to reach the end of an event
'  procedure (or a DoEvents call) before they are cooperating with Windows.
'  Instead of using DoEvents, which is a common technique that begs the issue, this
'  app will demonstrate a technique called "Finite State Automata", a.k.a State
'  Machines.  An application designed as a state machine has the following
'  advantages over a traditional "one-thing-at-a-time" app.  State machine apps can
'     1) restart long calculations in the middle without using recovery code
'     2) allow other Windows apps to operate uninterrupted
'     3) can perform other tasks for the user while the calculations are being done
'     4) can exit in the middle of an operation
'     5) can provide a faster response to the user, increasing their productivity
'     6) can better support DDE and OLE messaging schemes
'  In general, an application that makes good use of state machine architecture
'  can provide a cleaner, more appealing, and more productive interface to the
'  user than traditional applications.
'  The key to understanding this app is to recognize that only one portion of the
'  program is involved in the state machine: the process of searching for matching
'  file names.  The rest of the app: displaying the contents of the file or bringing
'  up notepad to edit the file, is regular VB code.
'  Therefore, only the single, long-duration process is involved in the state
'  machine itself.
'  In a state machine, the program stores "state" information in persistent
'  memory.  In VB, this means using module-level or global variables. These values
'  maintain information about "where we left off" so that, on each event, the
'  state machine can "pick up" the work, do a SMALL amount, store a little state
'  information, and exit.
'  Obviously, if a state machine only does a small amount of work, and then exits,
'  there needs to be some mechanism for restarting it.  An accepted technique in
'  VB is to use a timer control for this purpose.  However, if you want a more
'  "textbook" state machine, the event mechanism should be done by posting
'  messages in the message queue, so that each time one round completes, it posts
'  a message that will eventually trigger the next round.  Since "vanilla" VB has no
'  way to collect these messages, timers are the next best thing.
'  This program uses the timer 'tmrFSA' to trigger the state machine.  In fact, the
'  bulk of the state machine code is located in the tmrFSA_Timer event.
'  This routine works by placing the name of the starting directory in a "stack".
'  The state machine will pop the directory from the stack.  It will scan every file
'  in the directory.  If the file name matches the pattern provided, the name is
'  added to the list box.  If the file name is the name of a subdirectory, it is
'  pushed onto the stack.
'  Every iteration of the state machine will work on a single directory.  The
'  contents of the stack, and the state identifier, comprise the entire amount of
'  "global" information needed by the state machine.
'   Here is a call chain:
'   tmrFSA_Timer         ' state machine triggers
'      Dir() function    ' begins searching a directory
'      search_for_files  ' continues the search
'         examine_attributes    ' examines the current file's attributes
'  Note that the stack in an odd creature.  It is represented as an array.
'  Each element of the array is a list of directory names, seperated by a space.
'  As a new directory is encountered, the examine_attributes routine will append
'  the name of the directory to the current stack element's list of names.
'  I make no claim that this technique is the most efficient way to handle
'  variable-dimensioned arrays, but it works for the sake of this example...
'  and that's an accomplishment!
'  I hope that this introduction has been enough to get you started in
'  understanding this code.  If you have questions, or problems with this
'  code or any other VB issue, feel free to drop me a note at: 76055,2722
'  on Compuserve.  (the internet address is '[e-mail]' )
'  --- Nick Malik
'  Lecturer, Author, Consultant, and all-around nice guy
' -----------------------------------------------------------------
' ---------------
' the following declaration is used to send a message to the text box
' to set it to be a read-only text box.  See the routine set_read_only()
' for an example.
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' ---------------
' our entire cadre of global variables!
' most of these vars are initialized in cmdBegin_Click()
' and used in tmrFSA and it's children.
Dim curstate As Integer    ' current state  see ST_* below
Dim pathstack(50) As String    ' stack of directories yet to search
Dim stackpt As Integer         ' index of next free spot on the stack
Dim pattern As String      ' pattern to match against
Dim start_dir As String    ' where to come back to when we finish
Dim nfound     As Long     ' number of matches found
Dim dirscount As Long      ' number of directories found
'Current states in this state machine
Const ST_IDLE = 0        ' do nothing
Const ST_READ_DIR = 1    ' get a subdirectory from the current top of stack
Const ST_SCAN = 2        ' process current Directory, up to 100 items
' The state machine in this system is very simple
' State 0 - idle - if we hit this, turn off the timer and do nothing
' State 1 - DIR - give a search argument to the DIR function to begin
'                 searching for subdirectories and matching files.
' State 2 - DIR - no argument on DIR function, still in the process of
'                 searching for files.
' File Attribute constants.
' These are DOS values, returned by the GetAttr function
Const ATTR_NORMAL = 0       'Normal file
Const ATTR_READONLY = 1     'Read-only file
Const ATTR_HIDDEN = 2       'Hidden file
Const ATTR_SYSTEM = 4       'System file
Const ATTR_VOLUME = 8       'Volume label
Const ATTR_DIRECTORY = 16   'MS-DOS directory
Const ATTR_ARCHIVE = 32     'File has changed since last back-up
Sub cmdBegin_Click ()
    Dim fname$, pathdir$, patt$
    tmrFSA.Enabled = False
    cmdBegin.Enabled = False
    start_dir = CurDir$  ' save this for later
    fname$ = Trim$(enPattern.Text)
    If Len(fname$) = 0 Then
    pattern$ = "*"
    pathdir$ = ""
    Else
    parse_filename fname$, patt$, pathdir$
    If Len(patt$) = 0 Then
        pattern$ = "*"
    Else
        pattern$ = UCase$(patt$)
    End If
    End If
    If pathdir$ <> "" Then
    If Len(Trim(enRootDir.Text)) > 0 Then
        MsgBox "you cannot give a path in both the pattern and starting at boxes"
        Exit Sub
    End If
    Else
    pathdir$ = Trim$(enRootDir.Text)
    If Len(pathdir$) = 0 Then
        pathdir$ = Left$(CurDir$, 3)
    End If
    End If
    ' DOS complains when you try to change to a directory and you use a trailing slash,
    ' unless, of course, it is the root directory.
    If Len(pathdir$) > 3 And Right$(pathdir$, 1) = "\" Then
    pathdir$ = Left$(pathdir$, Len(pathdir) - 1)
    End If
    pathstack(0) = pathdir$
    stackpt = 0
    curstate = ST_READ_DIR
    cmdStop.Enabled = True
    tmrFSA.Enabled = True
    nfound = 0
    dirscount = 1
    lsMatched.Clear
End Sub
Sub cmdEdit_Click ()
    Dim rc%
    rc% = Shell("Notepad " & lbPathname.Caption)
End Sub
Sub cmdExit_Click ()
    Unload Me
    End
End Sub
Sub cmdStop_Click ()
    curstate = ST_IDLE
End Sub
'  given the name of a file, read the first 12000 bytes
'  from the file and display it in the text box
'  'enViewText'.  If the file is binary, display
'  a message to that effect.
Sub display_contents (filename As String)
    Dim fnum%
    Dim buffr$
    Dim trunc_string$
    Dim flen As Long
    On Error Resume Next
    fnum% = FreeFile
    Open filename For Binary As fnum%
    If Err <> 0 Then
    enViewText.Text = "Error opening file: " & filename & "   error is: " & Error$
    Exit Sub
    End If
    On Error GoTo dc_error
    enViewText.Text = ""
    flen = LOF(fnum%)   ' get the length of the file, in bytes
    If flen > 12000 Then
    flen = 12000
    trunc_string$ = Chr$(13) & Chr$(10) & " <<<<<< FILE DISPLAY TRUNCATED >>>>>>"
    Else
    trunc_string$ = ""
    End If
    buffr$ = Space$(flen)
    Get fnum%, , buffr$     ' get first 12000 characters of the file
    If isbinary(buffr$) Then
    enViewText.Text = "File is not in ASCII format, cannot be displayed"
    cmdEdit.Enabled = False
    Else
    enViewText.Text = buffr$ & trunc_string$
    cmdEdit.Enabled = True
    End If
    lbPathname.Caption = filename
dc_at_end:
    Close fnum%
    Exit Sub
dc_error:
    enViewText.Text = enViewText.Text & " <<  Error " & Error$ & " >> during read of file " & filename
    Resume dc_at_end
End Sub
'  This routine is called for each filename found.  The attributes of the
'  file are inspected to determine if the name is a file or a directory.
'  If it is a directory, it is added to the stack.  If it is a file, it
'  is compared against the pattern.  Matching files are added to the list box.
'  This routine is called by search_for_files()
Sub examine_attributes (filename$)
    Dim filepart$, pathpart$
    Dim attrib%
    attrib% = GetAttr(filename$)
    If (attrib% And ATTR_DIRECTORY) > 0 Then   ' got a directory
    If filename$ <> "." And filename$ <> ".." Then
        pathstack(stackpt) = pathstack(stackpt) & " " & filename$
        dirscount = dirscount + 1
    End If
    Else
    'parse_filename filename$, filepart$, pathpart$
    If filename$ Like pattern Then ' compare with global pattern
        lsMatched.AddItem list_name(filename$)
        nfound = nfound + 1
    End If
    End If
End Sub
'  start up with some nice defaults.
Sub Form_Load ()
    On Error Resume Next
    set_read_only enViewText
    enRootDir.Text = CurDir$
    enPattern.Text = "*.txt"
    lbPathname = ""
End Sub
'  find out if the file is binary...
'  read the first 1000 bytes of the buffer looking for binary characters
'  if you find too many, then the file is binary, so quit.
Function isbinary (buffer As String) As Integer
    Dim charix%, binct%, limit%
    Dim cval%
    On Error Resume Next
    limit% = Len(buffer)
    If limit% > 1024 Then limit% = 1024   ' only check the first 1K
    binct% = 0
    ' begin looking for binary characters
    For charix% = 1 To limit%
    cval% = Asc(Mid$(buffer, charix%, 1))
    ' don't complain about tabs and carriage returns, etc
    If (cval% < 8) Or ((cval% > 13) And (cval% < 32)) Then
        binct% = binct% + 1
        If binct% > 25 Then Exit For
    End If
    Next charix%
    ' if too many, or if more than 1/3 of all chars are binary, then it is!
    isbinary = (binct% > (limit% / 3)) Or (binct% > 25)
End Function
'  create a full path name from the parameter, which is assumed to be the
'  name of a file in the current directory.
Function list_name (fname$) As String
    Dim cdir$
    If Mid$(fname$, 2, 1) = ":" Then
    list_name = fname$
    Else
    cdir$ = CurDir$
    If Right$(cdir$, 1) <> "\" Then cdir$ = cdir$ & "\"
    list_name = LCase$(cdir$ & fname$)
    End If
End Function
Sub lsMatched_Click ()
    On Error Resume Next
    Dim fname$
    fname$ = lsMatched.List(lsMatched.ListIndex)
    display_contents fname$
End Sub
'  when passed a DOS filename in the first parameter, this routine
'  will return values in the second and third parameters.  The
'  second parameter will contain the name of the file itself, and
'  the third param will contain the directory tree it is under.
'   Note: the only time that 'pathonly$' does not end in a trailing
'  backslash is when the 'longname$' parameter did not contain one.
Sub parse_filename (longname$, filename$, pathonly$)
    Dim slashloc%
    Dim prevslash%
    prevslash% = InStr(longname$, "\")
    slashloc% = InStr(prevslash% + 1, longname$, "\")
    Do While slashloc% > 0
    prevslash% = slashloc%
    slashloc% = InStr(prevslash% + 1, longname$, "\")
    Loop
    filename$ = Mid$(longname$, prevslash% + 1)
    pathonly$ = Left$(longname$, prevslash%)
End Sub
'  given a list of directory names, seperated by spaces,
'  pull the first one from the list and trim the list.
Function pop_directory (dirnlist$) As String
    Dim newlist$        ' working value for the list param
    Dim firstdir$       ' value pulled from list
    Dim spacloc%        ' location of the first blank
    On Error Resume Next
    newlist$ = Trim$(dirnlist$)
    If Len(newlist$) = 0 Then
    dirnlist$ = ""
    pop_directory = ""
    Exit Function
    End If
    spacloc% = InStr(newlist$, " ")
    If spacloc% = 0 Then    ' no blanks found, list must contain only one item
    dirnlist$ = ""
    pop_directory = newlist$
    Else
    dirnlist$ = Trim$(Mid$(newlist$, spacloc% + 1))
    pop_directory = Left$(newlist$, spacloc% - 1)
    End If
End Function
'  Note: before this routine was called, the DIR() function must have
'  been called with a parameter.  This is needed to initialize this routine.
'  This routine will search for the next 100 files, or will stop at the end
'  of the directory, whichever comes first.
'  If it hits the end of subdir, this routine will return True, else it will
'     return False.
'  No state machine manipulations will happen in here... this is a work-horse
'     routine.
Function search_for_files () As Integer
    Dim fcount%
    Dim fname$
    Dim fattr%
    On Error Resume Next   ' ignore all errors
    For fcount% = 1 To 100
    fname$ = Dir
    If Len(fname$) = 0 Then
        search_for_files = True
        Exit Function
    End If
    ' the next routine will decide if the file is a directory or a matching text file
    examine_attributes fname$
    Next fcount%
    search_for_files = False
End Function
'  Flags a text box as read only, allowing the user to use the scroll bars,
'  and to copy to the clipboard, but not to edit the contents.
Sub set_read_only (txctrl As Control)
    Dim dis As Long
    Const EM_SETREADONLY = &H400 + 31
    dis = SendMessage(txctrl.hWnd, EM_SETREADONLY, 1, ByVal 0&)
End Sub
'  the entire state machine lives in here.
'  it is initialized in cmdBegin_Click()
'  this routine is called repeatedly, as long as the timer
'  is enabled.  As this routine comes in, it will check the
'  value of the state variable to determine which state to
'  process.
'     In each state, the search_for_files routine will look
'  through 100 files in a directory, or until the directory
'  runs out, whichever comes first.
'  The stack consists of an array of strings, where each
'  string represents the list of subdirectories at that level
'  that have yet to be searched.
'  (this is a generic DOS Directory search algorithm, only
'  using a stack array instead of recursion).
'  I suppose the stack could be more efficient, but I wasn't
'  going for string efficiency... I wanted to demonstrate a
'  pratical use for State Machines.
'  --- Nick Malik
Sub tmrFSA_Timer ()
    On Error Resume Next
    Dim srcdir$, fname$
    Select Case curstate
    Case ST_IDLE
    tmrFSA.Enabled = False
    cmdBegin.Enabled = True
    cmdStop.Enabled = False
    stackpt = 0
    ChDir start_dir
    pnCurDir.Caption = "Complete!  " & Format$(nfound) & " matches found in " & Format$(dirscount) & " dirs"
    Beep: Beep
    ' when we enter here, there will be a list of directory names (possibly
    ' including the drive letter) on the current position of the stack.
    ' pull one directory name from the stack, increment the stack pointer, and
    ' start looking
    Case ST_READ_DIR
    srcdir$ = pop_directory(pathstack(stackpt))
    If srcdir$ = "" Then   ' no elements, back up
        If stackpt <= 0 Then
        curstate = ST_IDLE ' we are done!
        Exit Sub
        End If
        stackpt = stackpt - 1
        ChDir ".."
        Exit Sub
    End If
    ChDir list_name(srcdir$)
    If Err <> 0 Then
        MsgBox "error : " & Error$
    End If
    pnCurDir.Caption = trimmed_dir(CurDir$)
    stackpt = stackpt + 1
    pathstack(stackpt) = ""
    fname$ = Dir("*.*", ATTR_DIRECTORY)
    examine_attributes fname$
    If search_for_files() Then
        ' to get here means we have exhausted the files in the current directory
        ' if the next stack position has any text in it, we should progress
        If Len(pathstack(stackpt)) > 0 Then Exit Sub
        ' to be here means we found no subdirectories... back up and try again
        ChDir ".."
        stackpt = stackpt - 1
    Else
        curstate = ST_SCAN
    End If
    ' when we enter here, we are in the middle of processing the list of files
    Case ST_SCAN
    ' the IF stmt below is functionally identical to the one above
    If search_for_files() Then
        curstate = ST_READ_DIR
        If Len(pathstack(stackpt)) > 0 Then
        Exit Sub
        End If
        ChDir ".."
        stackpt = stackpt - 1
    End If
    End Select
End Sub
'  given a possibly long path in 'indir', return a path that can be displayed in a caption
' of a 3-d panel
Function trimmed_dir (indir$) As String
    Dim predir$
    Dim temp$
    Dim slashloc%
    If Len(indir$) < 25 Then
    trimmed_dir = indir$
    Else
    predir$ = Left$(indir$, 3) ' get drive letter
    temp$ = Right$(indir$, 18)
    slashloc% = InStr(temp$, "\")
    trimmed_dir$ = predir$ & "..." & Mid$(temp$, slashloc%)
    End If
End Function